'This file has been updated from the original posting on CSERVE in 1993. It has been
'modified to support the WIN32 SDK API calls and works with 32bit VB4.
'Robert Wallace
'74604,501'
Option Explicit
Const WM_USER = &H400
Const LB_SETTABSTOPS = &H192
Const EM_SETTABSTOPS = &HCB
Const CB_SELECTSTRING = &H14D
Const LB_SELECTSTRING = &H18C
Const LB_SETHORIZONTALEXTENT = &H194
Type Size
X As Long
Y As Long
End Type
Public SizeStruct As Size
Const nSEARCH_FROM_TOP = -1
Declare Function dulist_nlSetTabstops Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Declare Function dulist_nlSelectString Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Declare Function dulist_nlGetTextExtent Lib "gdi32" Alias "GetTextExtentPoint32A" (ByVal hdc As Long, ByVal lpsz As String, ByVal cbString As Long, lpSize As Size) As Long
Declare Function dulist_nlGetDialogBaseUnits Lib "user32" Alias "GetDialogBaseUnits" () As Long
Declare Function dulist_nlSetHorizScrollBar Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Sub dulist_AddHorizScrollBar(ctlListControl As Control, fVirtualWidthRatio As Single)
Function dulist_tfSetListCols(ctlListControl As Control, ctlTextControl As Control, tfUseHeadingWidthsOnly As Integer, tfSetDefaultTabstops As Integer) As Integer
'This function automatically calculates and sets appropriate
'tabstops for a multi-column listbox, based on the actual data
'in the listbox. You do not have to tell the function how many
'columns you want, nor figure out how wide each column should be;
'the actual data placed into the listbox determines that.
'In addition to the listbox, the function also sets identical
'tabstops in an accompanying, multi-line textbox. This textbox
'provides the data for the column headings.
'tfUseHeadingWidthsOnly:
' True - Tabstops are calculated based only on the
' widths of the column headings. This option
' is must faster, but you're gambling that the
' actual data will always be narrower than the
' headings.
'
' False - Tabstops are calculated based on the widest
' entry in each column; both the headings and
' the data are examined. This option is slower
' because each entry in the listbox must be
' parsed, but it eliminates the guesswork.
'tfSetDefaultTabstops:
' True - Tabstops are reset to Windows' default intervals
' of 8 dialog units.
'
' False - Tabstops are calculated based on the actual
' data in the listbox/textbox.
'
'
'The function itself returns FALSE if any of the control
'verification tests fail; otherwise it returns TRUE.
Dim sTAB As String
Dim sColHeadings As String, sColData As String, sColString As String
Dim sParentFontName As String, fParentFontSize As Single
Dim tfParentFontBold As Integer, tfParentFontItalic As Integer
Dim nColCount As Integer, nDataWidth As Integer, nSpaceBetweenCols As Integer
Dim nMaxListboxCols As Integer, nNbrListboxCols As Integer, nNbrTabstops As Integer
Dim nInStart As Integer, nTabPos As Integer
Dim nListSub As Integer, nTabSub As Integer
Dim nlRC As Long
Dim nListFontAvgWidth As Integer, nSystemFontAvgWidth As Integer
Dim fListFontPixelsPerDlgUnit As Single, fFontRatio As Single
Dim nColWidth() As Integer 'measured column widths
Dim nTabstop() As Long 'calculated WinAPI tabstops
Dim RetVal As Long
'================
SetListCols_Main:
'================
dulist_tfSetListCols = True
GoSub SetListCols_VerifyControls
GoSub SetListCols_Initialize
If tfSetDefaultTabstops Then
nNbrTabstops = 0
GoSub SetListCols_UpdateControls
Else
'Since VB provides an hDC property for forms, but
'not for controls, we must temporarily set the parent
'form's font characteristics equal to the listbox's
'font characteristics. Doing this ensures that all
'text measurements made using the form's DC will be
